perm filename EXPRS.SAI[OLD,HE] blob
sn#506086 filedate 1980-03-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
C00004 00003 ! new_var,new_lbl,asglbl
C00006 00004 ! dtype, vtcheck
C00008 00005 ! vnode managers: add_vnode, okvnget
C00011 00006 ! inval0, invalidate, eval, getvalue, arrayref, vchange, dchange, killvar
C00021 00007 ! expeqv
C00023 00008 ! invsimp
C00025 00009 ! evalexpr
C00034 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
ENTRY; COMMENT Requirements, initialization of constants;
BEGIN "EXPRS"
DEFINE EXPRS_TERNAL = "INTERNAL";
IFCR ¬ DECLARATION(CREFFING) THENC DEFINE CREFFING = "FALSE";ENDC
IFCR ¬ CREFFING THENC
REQUIRE "ALREQ.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "GOBBLE.HDR[AL,HE]" SOURCE_FILE;
ENDC
REDEFINE $$PRGID "[]" = ["EXPRS"];
IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE;ENDC
ENDC
INTERNAL INTEGER CURTIME; INITIALIZE (CURTIME←1);
! new_var,new_lbl,asglbl;
INTERNAL RPTR(VARIABLE) PROCEDURE NEW_VAR(STRING NAME; INTEGER DT; RBLK BID);
BEGIN
RVAR VAR;
VAR ← NEW_RECORD(VARIABLE);
VARIABLE:NAME[VAR] ← NAME;
VARIABLE:DATATYPE[VAR] ← DT;
VARIABLE:BLK[VAR] ← BID;
IF BID ≠ RNULL THEN
IF DT = EVENT_DTYPE THEN CONSON(VAR,BLOCK:EVTS[BID])
ELSE CONSON(VAR,BLOCK:VARS[BID]);
RETURN(VAR);
END;
INTERNAL RPTR(LBLVAR) PROCEDURE NEW_LBL(STRING NAME; INTEGER DT; RBLK BID);
BEGIN
RPTR(LBLVAR) L;
L ← NEW_RECORD(LBLVAR);
LBLVAR:DATATYPE[L] ← DT;
LBLVAR:BLK[L] ← BID;
LBLVAR:NAME[L] ← NAME;
RETURN(L);
END;
INTERNAL RANY PROCEDURE ASGLBL(RPTR(LBLVAR) L;RPTR(ANY_CLASS) SEM);
BEGIN
IF RECTYPE(SEM) = LOC(STMNT) THEN ! have the stmnt point to the label;
BEGIN
STMNT:STLAB[SEM] ← L;
IF RECTYPE(STMNT:SEMANTICS[SEM]) = LOC(CMON) THEN
SEM ← STMNT:SEMANTICS[SEM];
END;
IF RECTYPE(SEM) = LOC(CMON) THEN LBLVAR:DATATYPE[L] ← OMNLAB_DTYPE;
LBLVAR:SEMANTICS[L] ← SEM;
RETURN(SEM)
END;
! dtype, vtcheck;
INTERNAL INTEGER SIMPLE PROCEDURE DTYPE(INTEGER DT);
START_CODE
MOVE 0,DT; ! this is cretinous, but ...;
MOVEI 1,0;
CAIN 0,SVAL_DTYPE;
MOVEI 1,SVAL;
CAIN 0,V3ECT_DTYPE;
MOVEI 1,V3ECT;
CAIN 0,ROTN_DTYPE;
MOVEI 1,ROTN;
CAIN 0,TRANS_DTYPE;
MOVEI 1,TRANS;
CAIN 0,FRAME_DTYPE;
MOVEI 1,FRAME;
END;
INTERNAL RPTR(VALU$) PROCEDURE VTCHECK(RVAR VAR; RPTR(VALU$) VAL);
BEGIN
INTEGER DT,VART;
DT ← VARIABLE:DATATYPE[VAR];
VART ← RECTYPE(VAL);
IF VART ≠ DTYPE(DT) THEN
IF DT=FRAME_DTYPE ∧ VART=LOC(TRANS) THEN RETURN(NEW_FRAME(VAL))
ELSE USERERR(1,1,"TYPE MISMATCH IN VTCHECK");
RETURN(VAL)
END;
RPTR(VALU$) PROCEDURE TFCVT(RPTR(VALU$) V); ! Used by evalexpr & eval;
IF RECTYPE(V)=LOC(FRAME) THEN RETURN(FRAME:VAL[V])
ELSE RETURN(V);
! vnode managers: add_vnode, okvnget;
PROCEDURE ADD_VNODE(RPTR(VNODE) VN, VL);
BEGIN ! Add vnode VN to vnode list headed by VL;
RPTR(VNODE) VO;
WHILE VL≠RNULL ∧ VNODE:VAR[VL] < VNODE:VAR[VN] DO VL ← VNODE:NEXT[(VO←VL)];
VNODE:NEXT[VN] ← VL;
VNODE:NEXT[VO] ← VN ! Splice into list;
END;
RPTR(VNODE) PROCEDURE OKVNGET(RVAR VAR; RTHREAD WLD);
BEGIN
! returns a graph node for VAR which may be modified in
world WLD without causing strange side effects in other
worlds;
RPTR(VNODE) GN;
GN ← VARIABLE:PLNVAL[VAR];
IF GN = RNULL ∨ VNODE:THREAD[GN] ≠ WLD THEN
BEGIN ! Make up a new vnode for this thread;
GN ← NEW_RECORD(VNODE);
VNODE:VAR[GN] ← VAR; ! Add back pointers;
VNODE:THREAD[GN] ← WLD;
VNODE:OLDVAL[GN] ← VARIABLE:PLNVAL[VAR]; ! If any;
VNODE:INVMARK[GN] ← -1;
VARIABLE:PLNVAL[VAR] ← GN;
ADD_VNODE(GN,THREAD:VALS[WLD]); ! Link onto value thread;
END;
RETURN(GN);
END;
! inval0, invalidate, eval, getvalue, arrayref, vchange, dchange, killvar;
! These routines perform graph node operations in a named planning world.
Their individual actions are those specified in the AL report. ;
RECURSIVE PROCEDURE INVAL0(RVAR VAR; RTHREAD WLD; REFERENCE RCELL INVLSEEN);
BEGIN
! procedure used as working loop of invalidate:
(1) looks to see if it has already invalidated VAR by
checking whether id of VAR is in INVLSEEN.
(2) if plnval vnode is null or valid, then
gets a vnode for this world & sets INVMARK to -1.
(3) processes all dependent nodes.
;
INTEGER RT;
RPTR(VNODE) GN;
RPTR(CALC) C;
IF MEMQ(VAR,INVLSEEN) THEN RETURN;
CONSON(VAR,INVLSEEN);
GN ← OKVNGET(VAR,WLD); ! Get a vnode for this world;
VNODE:INVMARK[GN] ← -1; ! It's no longer valid;
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO ! Invalidate everyone we're affixed to;
BEGIN
IF CALC:TYPE[C] ≠ 0 THEN ! Non-rigid + frame 1;
INVAL0(CALC:OTHER[C],WLD,INVLSEEN);
! ***** ????What happens to the bvar for non-rigid affixments here???? *****;
C ← CALC:NXTCALC[C]
END
END;
INTERNAL RPTR(VNODE) RECURSIVE PROCEDURE INVALIDATE(RVAR VAR; RTHREAD WLD);
BEGIN
RCELL INVLSEEN;
INVLSEEN ← RNULL;
INVAL0(VAR,WLD,INVLSEEN);
RETURN(VARIABLE:PLNVAL[VAR])
END;
RECURSIVE RPTR(VNODE) PROCEDURE EVAL (RVAR VAR; INTEGER T; RTHREAD WLD);
BEGIN
INTEGER I;
RPTR(VNODE) GN,OVN,BVN;
RPTR(CALC) C;
GN ← VARIABLE:PLNVAL[VAR];
! see if we already have a valid value, or have already looked for one;
IF GN ≠ RNULL ∧ (VNODE:INVMARK[GN]=0 ∨ VNODE:INVMARK[GN]=T) THEN RETURN(GN);
! nope - have to use a calc;
GN ← OKVNGET(VAR,WLD);
VNODE:INVMARK[GN] ← T;
FOR I ← 1 STEP 1 UNTIL 2 DO
BEGIN
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO
BEGIN
IF CALC:TYPE[C] ≠ 2 THEN ! Non-rigid + frame 2;
BEGIN
IF I = 1 THEN
BEGIN ! First time see if someone's already valid;
OVN ← VARIABLE:PLNVAL[CALC:OTHER[C]];
BVN ← VARIABLE:PLNVAL[CALC:BVAR[C]];
END
ELSE
BEGIN ! Second time try to validate someone;
OVN ← EVAL(CALC:OTHER[C], T, WLD);
BVN ← EVAL(CALC:BVAR[C], T, WLD)
END;
IF OVN ≠ RNULL ∧ VNODE:INVMARK[OVN] = 0
∧ BVN ≠ RNULL ∧ VNODE:INVMARK[BVN] = 0 THEN ! Both are valid;
BEGIN
RPTR(TRANS,FRAME) T1,T2;
T1 ← TFCVT(VNODE:VAL[OVN]);
T2 ← TFCVT(VNODE:VAL[BVN]);
IF CALC:TYPE[C] LAND 2 THEN T2 ← TINVRT(T2); ! Frame 2;
VNODE:VAL[GN] ← NEW_FRAME(TTMUL(T1,T2));
VNODE:INVMARK[GN] ← 0;
RETURN(GN)
END
END;
C ← CALC:NXTCALC[C]
END
END;
RETURN(GN); ! we did the best we could;
END;
INTERNAL RPTR(VALU$) PROCEDURE GETVALUE (RVAR VAR;
RTHREAD WLD; BOOLEAN OK(FALSE));
BEGIN
RPTR(VNODE) GN;
GN ← VARIABLE:PLNVAL[VAR];
IF GN = RNULL ∨ VNODE:INVMARK[GN] ≠ 0 THEN
GN ← EVAL(VAR,CURTIME←CURTIME+1,WLD);
IF GN = RNULL ∨ VNODE:INVMARK[GN] ≠ 0 THEN
BEGIN
IF ¬OK THEN PRINT(CRLF & "WARNING: ", VARIABLE:NAME[VAR],
" has no plan value - will use zero" & CRLF);
CASE VARIABLE:DATATYPE[VAR] OF
BEGIN ! really return something so we;
[SVAL_DTYPE] RETURN(FALSEV); ! don't generate more error;
[V3ECT_DTYPE] RETURN(NILVECT); ! messages than need be;
[ROTN_DTYPE] RETURN(NILROTN);
[TRANS_DTYPE] RETURN(NILTRANS);
[FRAME_DTYPE] RETURN(NILDEPROACH);
ELSE RETURN(RNULL)
END
END;
RETURN(VNODE:VAL[GN]);
END;
INTERNAL RECURSIVE RVAR PROCEDURE ARRAYREF(REXPR E; RTHREAD WLD);
BEGIN
INTEGER I,J,N;
RCELL SS;
RPTR(ARRAYDEF) H;
SS ← EXPRN:ARGS[E];
H ← LLOP(SS);
I ← N ← 1;
WHILE SS ≠ RNULL ∧ I ≤ ARRAYDEF:NUMDIMS[H] DO
BEGIN
J ← SVAL:VAL[EVALEXPR(LLOP(SS),WLD)]; ! get subscript's value;
IF J > ARRAYDEF:BDVALS[H][I,1] THEN
BEGIN
USERERR(1,1,"ARRAYREF: SUBSCRIPT TOO LARGE");
J ← ARRAYDEF:BDVALS[H][I,1]
END;
IF (J ← J - ARRAYDEF:BDVALS[H][I,0]) < 0 THEN
BEGIN
USERERR(1,1,"ARRAYREF: SUBSCRIPT TOO SMALL");
J ← 0
END;
N ← N + J * ARRAYDEF:BDVALS[H][I,2];
I ← I + 1
END;
RETURN(ARRAYDEF:VARS[H][N])
END;
INTERNAL RECURSIVE PROCEDURE VCHANGE(RPTR(VARIABLE,EXPRN) VAR;
RPTR(VALU$) NEWV; RTHREAD WLD);
BEGIN
RPTR(VNODE) GN;
RPTR(CALC) C;
IF (RECTYPE(VAR)=LOC(EXPRN)) ∧ (EXPRN:OP[VAR]=AREF_OP) THEN
VAR ← ARRAYREF(VAR,WLD);
GN ← INVALIDATE(VAR,WLD);
IF NEWV ≠ RNULL THEN
BEGIN
VNODE:VAL[GN] ← VTCHECK(VAR,NEWV);
VNODE:INVMARK[GN] ← 0;
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO
BEGIN
IF CALC:TYPE[C] = 0 THEN ! Non-rigid + frame 1;
VCHANGE(CALC:BVAR[C],TTMUL(
TINVRT(GETVALUE(CALC:OTHER[C],WLD,TRUE)), NEWV), WLD);
C ← CALC:NXTCALC[C]
END
END
ELSE VNODE:INVMARK[GN] ← -1;
END;
INTERNAL PROCEDURE DCHANGE(RPTR(VARIABLE,EXPRN) VAR;
RPTR(VALU$) NEWV; RTHREAD WLD);
BEGIN
RPTR(VNODE) GN;
IF (RECTYPE(VAR)=LOC(EXPRN)) ∧ (EXPRN:OP[VAR]=AREF_OP) THEN
VAR ← ARRAYREF(VAR,WLD);
GN ← VARIABLE:DEPR[VAR];
IF GN = RNULL ∨ VNODE:THREAD[GN] ≠ WLD THEN
BEGIN ! Make up a new vnode for this thread;
GN ← NEW_RECORD(VNODE);
VNODE:VAR[GN] ← VAR; ! Add back pointers;
VNODE:THREAD[GN] ← WLD;
VNODE:OLDVAL[GN] ← VARIABLE:DEPR[VAR]; ! If any;
VARIABLE:DEPR[VAR] ← GN;
ADD_VNODE(GN,THREAD:DEPRS[WLD]); ! Link onto value thread;
END;
VNODE:VAL[GN] ← NEWV
END;
INTERNAL PROCEDURE KILLVAR(RTHREAD WLD; RVAR VAR);
BEGIN
RPTR(CALC) C;
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO ! Unfix us from rest of world;
BEGIN
DO_UNFIX(WLD,VAR,CALC:OTHER[C]); ! Unfix will validate them if possible;
C ← VARIABLE:CALCS[VAR]
END
END;
! expeqv;
! Symbolic comparison of expressions. not very bright about
commutative laws, etc. Returns TRUE if it thinks that E1 ≡ E2;
INTERNAL RECURSIVE BOOLEAN PROCEDURE EXPEQV(RPTR(EXPRN,VALU$,VARIABLE) E1,E2);
BEGIN
INTEGER T1,T2;
IF E1 = E2 THEN RETURN(TRUE);
T1←RECTYPE(E1);T2←RECTYPE(E2);
IF T1≠ T2 THEN RETURN(FALSE);
IF T1= LOC(VARIABLE) THEN RETURN(FALSE); ! had to be eq;
IF T1= LOC(SVAL) THEN RETURN(SVAL:VAL[E1]=SVAL:VAL[E2]);
IF T1= LOC(V3ECT) THEN RETURN(V3CMP(E1,E2)=0);
IF T1= LOC(ROTN) THEN RETURN(ROTCMP(E1,E2)=0);
IF T1= LOC(TRANS) THEN RETURN(TRANSCMP(E1,E2)=0);
IF T1= LOC(FRAME) THEN RETURN(TRANSCMP(FRAME:VAL[E1],FRAME:VAL[E2])=0);
IF T1= LOC(EXPRN) THEN
BEGIN
RCELL C1,C2;
IF EXPRN:OP[E1]≠EXPRN:OP[E2] THEN RETURN(FALSE);
IF EXPRN:DATATYPE[E1]≠EXPRN:DATATYPE[E2] THEN RETURN(FALSE);
C1←EXPRN:ARGS[E1];C2←EXPRN:ARGS[E2];
WHILE C1≠NULL_RECORD ∧ C2≠NULL_RECORD DO
BEGIN
IF ¬EXPEQV(CELL:CAR[C1],CELL:CAR[C2]) THEN RETURN(FALSE);
C1←CELL:CDR[C1];
C2←CELL:CDR[C2];
END;
RETURN(C1=C2);
END;
USERERR(1,1,"EXPEQV: CONFUSION");
RETURN(FALSE);
END;
! invsimp;
INTERNAL REXPR RECPROC INVSIMP(REXPR E);
BEGIN
REXPR EE;RCELL C,CC;
BOOLEAN FLAG;
IF RECTYPE(E)≠LOC(EXPRN) THEN RETURN(E);
FLAG←FALSE;
C←EXPRN:ARGS[E];
IF EXPRN:OP[E]=TINVRT_OP THEN
BEGIN
EE←INVSIMP(CELL:CAR[C]);
IF RECTYPE(EE)=LOC(EXPRN) THEN
BEGIN
IF EXPRN:OP[EE]=TINVRT_OP THEN RETURN(CELL:CAR[EXPRN:ARGS[EE]])
END;
IF EE≠CELL:CAR[C] THEN
BEGIN
FLAG←TRUE;
CC←CONS(EE,NULL_RECORD)
END;
END
ELSE WHILE C≠NULL_RECORD DO
BEGIN
EE←INVSIMP(LLOP(C));
CC←APPEND(CC,CONS(EE,NULL_RECORD));
FLAG←TRUE;
END;
IF FLAG THEN RETURN(NEW_EXPRN(EXPRN:DATATYPE[E],EXPRN:OP[E],CC))
ELSE RETURN(E)
END;
! evalexpr ;
INTERNAL RPTR(VALU$) RECPROC EVALEXPR(RPTR(EXPRN,VARIABLE,VALU$) E;RTHREAD WLD);
BEGIN
! evaluates the planning value of expression-like thing E in
world WLD & returns a value (e.g., vector, sval, trans) ;
RPTR(CELL) C;
RPTR(VALU$) V1,V2,V3;
INTEGER ETYP;
IF E=NULL_RECORD THEN RETURN(E);
ETYP ← RECTYPE(E);
IF ETYP = LOC(VARIABLE) THEN RETURN(GETVALUE(E,WLD))
ELSE IF ETYP=LOC(SVAL) ∨ ETYP=LOC(FRAME) ∨ ETYP=LOC(TRANS) ∨
ETYP=LOC(V3ECT) ∨ ETYP=LOC(ROTN) THEN
RETURN(E)
ELSE IF ETYP=LOC(FORCE) THEN
RETURN(NEW_SVAL(0)) ! No idea what the actual value will be;
ELSE IF ETYP≠LOC(EXPRN) THEN
BEGIN
USERERR(1,1,"EVALEXPR: BAD ARGUMENT");
RETURN(NULL_RECORD);
END;
C←EXPRN:ARGS[E];
IF EXPRN:OP[E]=AREF_OP ∨ EXPRN:OP[E]=CALL_OP ∨ EXPRN:OP[E]=QUERY_OP
THEN C←RNULL;
IF C≠NULL_RECORD THEN V1←TFCVT(EVALEXPR(LLOP(C),WLD));
IF C≠NULL_RECORD THEN V2←TFCVT(EVALEXPR(LLOP(C),WLD));
IF C≠NULL_RECORD THEN V3←TFCVT(EVALEXPR(LLOP(C),WLD));
CASE EXPRN:OP[E] OF
BEGIN
[NO_OP] RETURN(V1);
[SCALRD_OP]
[QUERY_OP] RETURN(FALSEV);
[SABS_OP] RETURN(NEW_SVAL(ABS SVAL:VAL[V1]));
[SNEG_OP] RETURN(NEW_SVAL(-SVAL:VAL[V1]));
[SADD_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]+SVAL:VAL[V2]));
[SSUB_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]-SVAL:VAL[V2]));
[SMUL_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]*SVAL:VAL[V2]));
[SDIV_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]/SVAL:VAL[V2]));
[SEXP_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]↑SVAL:VAL[V2]));
[MAX_OP] RETURN(NEW_SVAL(SVAL:VAL[V1] MAX SVAL:VAL[V2]));
[MIN_OP] RETURN(NEW_SVAL(SVAL:VAL[V1] MIN SVAL:VAL[V2]));
[INT_OP] RETURN(NEW_SVAL(SVAL:VAL[V1] DIV 1));
[DIV_OP] RETURN(NEW_SVAL(SVAL:VAL[V1] DIV SVAL:VAL[V2]));
[MOD_OP] RETURN(NEW_SVAL(SVAL:VAL[V1] MOD SVAL:VAL[V2]));
[SLT_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]<SVAL:VAL[V2]));
[SEQ_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]=SVAL:VAL[V2]));
[SLE_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]≤SVAL:VAL[V2]));
[SGE_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]≥SVAL:VAL[V2]));
[SNE_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]≠SVAL:VAL[V2]));
[SGT_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]>SVAL:VAL[V2]));
[AND_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]∧SVAL:VAL[V2]));
[OR_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]∨SVAL:VAL[V2]));
[NOT_OP] RETURN(NEW_SVAL(¬SVAL:VAL[V1]));
[XOR_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]⊗SVAL:VAL[V2]));
[EQV_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]≡SVAL:VAL[V2]));
[VMAGN_OP] RETURN(NEW_SVAL(SQRT(V3DOT(V1,V1))));
[VDOT_OP] RETURN(NEW_SVAL(V3DOT(V1,V2)));
[VCROSS_OP] RETURN(V3CROSS(V1,V2));
[RMAGN_OP] RETURN(RMAGN(V1));
[AXIS_OP] RETURN(AXIS(V1));
[SVMUL_OP] RETURN(SVMUL(SVAL:VAL[V1],V2));
[VSDIV_OP] RETURN(SVMUL(1.0/SVAL:VAL[V2],V1));
[VMAKE_OP] RETURN(NEW_V3ECT(SVAL:VAL[V1],SVAL:VAL[V2],SVAL:VAL[V3]));
[VADD_OP] RETURN(V3ADD(V1,V2));
[VSUB_OP] RETURN(V3SUB(V1,V2));
[RVMUL_OP] RETURN(RVMUL(V1,V2));
[UVECT_OP] RETURN(UVECT(V1));
[POS_OP] RETURN(POS(V1));
[ORIENT_OP] RETURN(ORIENT(V1));
[AXW_ROTN_OP] RETURN(AXW_ROTN(V1,SVAL:VAL[V2]));
[RRMUL_OP] RETURN(RRMUL(V1,V2));
[TMAKE_OP] RETURN(NEW_TRANS(CHKREC(V1,LOC(ROTN)),CHKREC(V2,LOC(V3ECT)) ));
[CONSTR_OP] RETURN(CONSTR(V1,V2,V3));
[TVADD_OP] RETURN(NEW_TRANS(TRANS:R[V1],V3ADD(TRANS:P[V1],V2)));
[TVSUB_OP] RETURN(NEW_TRANS(TRANS:R[V1],V3SUB(TRANS:P[V1],V2)));
[TVMUL_OP] RETURN(TVMUL(V1,V2));
[FTOF_OP] RETURN(TTMUL(TINVRT(CHKREC(V1,LOC(TRANS))),CHKREC(V2,LOC(TRANS))) );
[TTMUL_OP] RETURN(TTMUL(V1,V2));
[TINVRT_OP] RETURN(TINVRT(V1));
[DEPR_OP] BEGIN
IF V2 ≠ RNULL THEN RETURN(V2);
V2 ← DEPR(CELL:CAR[EXPRN:ARGS[E]]); ! in wldmod not arith;
CONSON(V2,EXPRN:ARGS[E]);
RETURN(EVALEXPR(V2,WLD));
END;
[FMAKE_OP] RETURN(NEW_FRAME(
NEW_TRANS(CHKREC(V1,LOC(ROTN)),CHKREC(V2,LOC(V3ECT)) ) ));
[TFMAKE_OP] RETURN(NEW_FRAME(V1));
[SSBRTN_OP] CASE (ETYP←SVAL:VAL[V1]) OF
BEGIN
[SQRT_OP] RETURN(NEW_SVAL(SQRT(SVAL:VAL[V2])));
[SIN_OP] RETURN(NEW_SVAL(SIND(SVAL:VAL[V2])));
[COS_OP] RETURN(NEW_SVAL(COSD(SVAL:VAL[V2])));
[TAN_OP] RETURN(NEW_SVAL(SIND(SVAL:VAL[V2])/COSD(SVAL:VAL[V2])));
[ASIN_OP] RETURN(NEW_SVAL(ASIN(SVAL:VAL[V2]) * DEG));
[ACOS_OP] RETURN(NEW_SVAL(ACOS(SVAL:VAL[V2]) * DEG));
[ATAN2_OP] RETURN(NEW_SVAL(ATAN2(SVAL:VAL[V2],SVAL:VAL[V3])*DEG));
[LOG_OP] RETURN(NEW_SVAL(LOG(SVAL:VAL[V2])));
[EXP_OP] RETURN(NEW_SVAL(EXP(SVAL:VAL[V2])));
[TIME_OP] RETURN(NEW_SVAL(SVAL:VAL[V2]+1.0))
END;
[AREF_OP] RETURN(GETVALUE(ARRAYREF(E,WLD),WLD));
[CALL_OP] CASE PROCDEF:DATATYPE[CELL:CAR[EXPRN:ARGS[E]]] OF
BEGIN
[SVAL_DTYPE] RETURN(FALSEV);
[V3ECT_DTYPE] RETURN(NILVECT);
[ROTN_DTYPE] RETURN(NILROTN);
[TRANS_DTYPE] RETURN(NILTRANS);
[FRAME_DTYPE] RETURN(NILDEPROACH);
ELSE RETURN(FALSEV)
END;
[LAST_OP] END;
USERERR(1,1,"EVALEXPR: INVALID OP");
RETURN(NULL_RECORD);
END;
END $$PRGID;